home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp2.arc / PIBASYNC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-02  |  60.0 KB  |  1,274 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         PIBASYNC.PAS   --- Asynchronous I/O for Turbo Pascal         *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Version: 1.0   (January, 1985)                                      *)
  8. (*           2.0   (June, 1985)                                         *)
  9. (*           2.1   (July, 1985)                                         *)
  10. (*                                                                      *)
  11. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  12. (*           Note:  I have checked these on Zenith 151s under           *)
  13. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  14. (*                                                                      *)
  15. (*  History: Some of these routines are based upon ones written by:     *)
  16. (*                                                                      *)
  17. (*              Alan Bishop                                             *)
  18. (*              C. J. Dunford                                           *)
  19. (*              Michael Quinlan                                         *)
  20. (*                                                                      *)
  21. (*           I have cleaned up these other authors' code, fixed some    *)
  22. (*           bugs, and added many new features.                         *)
  23. (*                                                                      *)
  24. (*           Suggestions for improvements or corrections are welcome.   *)
  25. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  26. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  27. (*                                                                      *)
  28. (*           If you use this code in your own programs, please be nice  *)
  29. (*           and give all of us credit.                                 *)
  30. (*                                                                      *)
  31. (*----------------------------------------------------------------------*)
  32. (*                                                                      *)
  33. (*  Routines:                                                           *)
  34. (*                                                                      *)
  35. (*     Async_Init             ---    Performs initialization.           *)
  36. (*     Async_Clear_Errors     ---    Clear pending serial port errors   *)
  37. (*     Async_Reset_Port       ---    Resets UART parameters for port    *)
  38. (*     Async_Open             ---    Sets up COM port                   *)
  39. (*     Async_Close            ---    Closes down COM port               *)
  40. (*     Async_Carrier_Detect   ---    Checks for modem carrier detect    *)
  41. (*     Async_Carrier_Drop     ---    Checks for modem carrier drop      *)
  42. (*     Async_Buffer_Check     ---    Checks if character in COM buffer  *)
  43. (*     Async_Buffer_Full      ---    Checks if async buffer nearly full *)
  44. (*     Async_Term_Ready       ---    Toggles terminal ready status      *)
  45. (*     Async_Receive          ---    Reads character from COM buffer    *)
  46. (*     Async_Receive_With_Timeout                                       *)
  47. (*                            ---    Receives char. with timeout check  *)
  48. (*     Async_Ring_Detect      ---    If ringing detected                *)
  49. (*     Async_Send             ---    Transmits char over COM port       *)
  50. (*     Async_Send_String      ---    Sends string over COM port         *)
  51. (*     Async_Send_String_With_Delays                                    *)
  52. (*                            ---    Sends string with timed delays     *)
  53. (*     Async_Send_Break       ---    Sends break (attention) signal     *)
  54. (*     Async_Percentage_Used  ---    Returns percentage com buffer used *)
  55. (*     Async_Purge_Buffer     ---    Purges receive buffer              *)
  56. (*                                                                      *)
  57. (*----------------------------------------------------------------------*)
  58. (*                                                                      *)
  59. (*----------------------------------------------------------------------*)
  60.  
  61.  
  62. (*----------------------------------------------------------------------*)
  63. (*                                                                      *)
  64. (*                  COMMUNICATIONS HARDWARE ADDRESSES                   *)
  65. (*                                                                      *)
  66. (*        These are specific to IBM PCs and close compatibles.          *)
  67. (*                                                                      *)
  68. (*----------------------------------------------------------------------*)
  69.  
  70. CONST
  71.  
  72.  
  73.    UART_THR = $00;       (* offset from base of UART Registers for IBM PC *)
  74.    UART_RBR = $00;
  75.    UART_IER = $01;
  76.    UART_IIR = $02;
  77.    UART_LCR = $03;
  78.    UART_MCR = $04;
  79.    UART_LSR = $05;
  80.    UART_MSR = $06;
  81.  
  82.    I8088_IMR = $21;      (* port address of the Interrupt Mask Register *)
  83.  
  84.    COM1_Base = $03F8;    (* port addresses for the UART *)
  85.    COM2_Base = $02F8;
  86.  
  87.    COM1_Irq = 4;         (* Interrupt line for the UART *)
  88.    COM2_Irq = 3;
  89.  
  90. CONST
  91.  
  92.    Async_DSeg_Save : INTEGER = 0;  (* Save DS reg in Code Segment for *)
  93.                                    (* interrupt routine               *)
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (*                                                                      *)
  97. (*                   COMMUNICATIONS BUFFER VARIABLES                    *)
  98. (*                                                                      *)
  99. (*     The Communications Buffer is implemented as a circular (ring)    *)
  100. (*     buffer, or double-ended queue.  The asynchronous I/O routines    *)
  101. (*     enter characters in the buffer as they are received.  Higher-    *)
  102. (*     level routines may extract characters from the buffer.           *)
  103. (*                                                                      *)
  104. (*     Note that this buffer is used for input only;  output is done    *)
  105. (*     on a character-by-character basis.                               *)
  106. (*                                                                      *)
  107. (*----------------------------------------------------------------------*)
  108.  
  109. CONST
  110.  
  111.    Async_Buffer_Max    = 4095;       (* Size of Communications Buffer   *)
  112.    TimeOut             = 256;        (* TimeOut value                   *)
  113.  
  114. VAR
  115.                                      (* Communications Buffer Itself *)
  116.  
  117.    Async_Buffer          : ARRAY[0..Async_Buffer_Max] OF CHAR;
  118.  
  119.    Async_Open_Flag       : BOOLEAN;  (* true if Open but no Close         *)
  120.    Async_Port            : INTEGER;  (* current Open port number (1 or 2) *)
  121.    Async_Base            : INTEGER;  (* base for current open port        *)
  122.    Async_Irq             : INTEGER;  (* irq for current open port         *)
  123.  
  124.    Async_Buffer_Overflow : BOOLEAN;  (* True if buffer overflow has happened *)
  125.    Async_Buffer_Used     : INTEGER;
  126.    Async_MaxBufferUsed   : INTEGER;
  127.  
  128.                                      (* Async_Buffer empty if Head = Tail    *)
  129.    Async_Buffer_Head    : INTEGER;   (* Loc in Async_Buffer to put next char *)
  130.    Async_Buffer_Tail    : INTEGER;   (* Loc in Async_Buffer to get next char *)
  131.    Async_Buffer_NewTail : INTEGER;
  132.  
  133.    Async_XOFF_Sent      : BOOLEAN    (* If XOFF sent                         *);
  134.    Async_Baud_Rate      : INTEGER    (* Current baud rate                    *);
  135.  
  136. CONST
  137.    Async_XON            : CHAR = ^Q  (* XON character                        *);
  138.    Async_XOFF           : CHAR = ^S  (* XOFF character                       *);
  139.  
  140. (*----------------------------------------------------------------------*)
  141. (*                BIOS_RS232_Init --- Initialize UART                   *)
  142. (*----------------------------------------------------------------------*)
  143.  
  144. PROCEDURE BIOS_RS232_Init( ComPort, ComParm : INTEGER );
  145.  
  146. (*----------------------------------------------------------------------*)
  147. (*                                                                      *)
  148. (*     Procedure:  BIOS_RS232_Init                                      *)
  149. (*                                                                      *)
  150. (*     Purpose:    Issues interrupt $14 to initialize the UART          *)
  151. (*                                                                      *)
  152. (*     Calling Sequence:                                                *)
  153. (*                                                                      *)
  154. (*        BIOS_RS232_Init( ComPort, ComParm : INTEGER );                *)
  155. (*                                                                      *)
  156. (*           ComPort  --- Communications Port Number (1 or 2)           *)
  157. (*           ComParm  --- Communications Parameter Word                 *)
  158. (*                                                                      *)
  159. (*      Calls:   INTR   (to perform BIOS interrupt $14)                 *)
  160. (*                                                                      *)
  161. (*----------------------------------------------------------------------*)
  162.  
  163. VAR
  164.    Regs: RegPack;
  165.  
  166. BEGIN   (* BIOS_RS232_Init *)
  167.  
  168.    WITH Regs DO
  169.       BEGIN
  170.          Ax := ComParm AND $00FF;  (* AH=0; AL=ComParm   *)
  171.          Dx := ComPort;            (* Port number to use *)
  172.          INTR($14, Regs);
  173.       END;
  174.  
  175. END    (* BIOS_RS232_Init *);
  176.  
  177.  
  178. (*----------------------------------------------------------------------*)
  179. (*             DOS_Set_Intrpt --- Call DOS to set interrupt vector      *)
  180. (*----------------------------------------------------------------------*)
  181.  
  182. PROCEDURE DOS_Set_Intrpt( v, s, o : INTEGER );
  183.  
  184. (*----------------------------------------------------------------------*)
  185. (*                                                                      *)
  186. (*     Procedure:  DOS_Set_Intrpt                                       *)
  187. (*                                                                      *)
  188. (*     Purpose:    Calls DOS to set interrupt vector                    *)
  189. (*                                                                      *)
  190. (*     Calling Sequence:                                                *)
  191. (*                                                                      *)
  192. (*        DOS_Set_Intrpt( v, s, o : INTEGER );                          *)
  193. (*                                                                      *)
  194. (*           v --- interrupt vector number to set                       *)
  195. (*           s --- segment address of interrupt routine                 *)
  196. (*           o --- offset address of interrupt routine                  *)
  197. (*                                                                      *)
  198. (*      Calls:   MSDOS   (to set interrupt)                             *)
  199. (*                                                                      *)
  200. (*----------------------------------------------------------------------*)
  201.  
  202. VAR
  203.    Regs : Regpack;
  204.  
  205. BEGIN   (* DOS_Set_Intrpt *)
  206.  
  207.    WITH Regs DO
  208.       BEGIN
  209.          Ax := $2500 + ( v AND $00FF );
  210.          Ds := s;
  211.          Dx := o;
  212.          MsDos( Regs );
  213.       END;
  214.  
  215. END    (* DOS_Set_Intrpt *);
  216.  
  217. (*----------------------------------------------------------------------*)
  218. (*               Async_Isr --- Interrupt Service Routine                *)
  219. (*----------------------------------------------------------------------*)
  220.  
  221. PROCEDURE Async_Isr;
  222.  
  223. (*----------------------------------------------------------------------*)
  224. (*                                                                      *)
  225. (*     Procedure:  Async_Isr                                            *)
  226. (*                                                                      *)
  227. (*     Purpose:    Invoked when UART has received character from        *)
  228. (*                 communications line  (asynchronous)                  *)
  229. (*                                                                      *)
  230. (*     Calling Sequence:                                                *)
  231. (*                                                                      *)
  232. (*        Async_Isr;                                                    *)
  233. (*                                                                      *)
  234. (*           --- Called asyncronously only!!!!!!                        *)
  235. (*                                                                      *)
  236. (*     Remarks:                                                         *)
  237. (*                                                                      *)
  238. (*        This is Michael Quinlan's version of the interrupt handler.   *)
  239. (*                                                                      *)
  240. (*----------------------------------------------------------------------*)
  241.  
  242. BEGIN   (* Async_Isr *)
  243.  
  244.   (*  NOTE: on entry, Turbo Pascal has already PUSHed BP and SP  *)
  245.  
  246.   INLINE(
  247.       (* save all registers used *)
  248.  
  249.           $50/$53/$51/$52/$56/$57/$1E/$06/$FB/
  250.  
  251.       (* set up the DS register to point to Turbo Pascal's data segment *)
  252.     $2E/$FF/$36/Async_Dseg_Save/   (* PUSH CS:Async_Dseg_Save *)
  253.     $1F/                           (* POP DS *)
  254.       (* get the incoming character *)
  255.       (* Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); *)
  256.     $8B/$16/Async_Base/            (* MOV DX,Async_Base *)
  257.     $EC/                           (* IN AL,DX *)
  258.     $8B/$1E/Async_Buffer_Head/     (* MOV BX,Async_Buffer_Head *)
  259.     $88/$87/Async_Buffer/          (* MOV Async_Buffer[BX],AL *)
  260.       (* Async_Buffer_NewHead := Async_Buffer_Head + 1; *)
  261.     $43/                           (* INC BX *)
  262.       (* if Async_Buffer_NewHead > Async_Buffer_Max then
  263.           Async_Buffer_NewHead := 0; *)
  264.     $81/$FB/Async_Buffer_Max/      (* CMP BX,Async_Buffer_Max *)
  265.     $7E/$02/                       (* JLE L001 *)
  266.     $33/$DB/                       (* XOR BX,BX *)
  267.       (* if Async_Buffer_NewHead = Async_Buffer_Tail then
  268.           Async_Buffer_Overflow := TRUE
  269.         else *)
  270. (*L001:*)
  271.     $3B/$1E/Async_Buffer_Tail/     (* CMP BX,Async_Buffer_Tail *)
  272.     $75/$08/                       (* JNE L002 *)
  273.     $C6/$06/Async_Buffer_Overflow/$01/ (* MOV Async_Buffer_Overflow,1 *)
  274.     $90/                           (* NOP generated by assembler for some reason *)
  275.     $EB/$16/                       (* JMP SHORT L003 *)
  276.       (* begin
  277.           Async_Buffer_Head := Async_Buffer_NewHead;
  278.           Async_Buffer_Used := Async_Buffer_Used + 1;
  279.           if Async_Buffer_Used > Async_MaxBufferUsed then
  280.             Async_MaxBufferUsed := Async_Buffer_Used
  281.         end; *)
  282. (*L002:*)
  283.     $89/$1E/Async_Buffer_Head/     (* MOV Async_Buffer_Head,BX *)
  284.     $FF/$06/Async_Buffer_Used/     (* INC Async_Buffer_Used *)
  285.     $8B/$1E/Async_Buffer_Used/     (* MOV BX,Async_Buffer_Used *)
  286.     $3B/$1E/Async_MaxBufferUsed/   (* CMP BX,Async_MaxBufferUsed *)
  287.     $7E/$04/                       (* JLE L003 *)
  288.     $89/$1E/Async_MaxBufferUsed/   (* MOV Async_MaxBufferUsed,BX *)
  289. (*L003:*)
  290.       (* disable interrupts *)
  291.     $FA/                           (* CLI *)
  292.       (* Port[$20] := $20; *)  (* use non-specific EOI *)
  293.     $B0/$20/                       (* MOV AL,20h *)
  294.     $E6/$20/                       (* OUT 20h,AL *)
  295.       (* restore the registers then use IRET to return *)
  296.       (* the last two POPs are required because Turbo Pascal PUSHes these regs
  297.         before we get control.  The manual doesn't say so, but that is what
  298.         really happens *)
  299.     $07/$1F/$5F/$5E/$5A/$59/$5B/$58/$8B/$E5/$5D/
  300.     $CF)                           (* IRET *)
  301.  
  302. END    (* Async_Isr *);
  303.  
  304. (*----------------------------------------------------------------------*)
  305. (*               Async_Init --- Initialize Asynchronous VARiables       *)
  306. (*----------------------------------------------------------------------*)
  307.  
  308. PROCEDURE Async_Init;
  309.  
  310. (*----------------------------------------------------------------------*)
  311. (*                                                                      *)
  312. (*     Procedure:  Async_Init                                           *)
  313. (*                                                                      *)
  314. (*     Purpose:    Initializes variables                                *)
  315. (*                                                                      *)
  316. (*     Calling Sequence:                                                *)
  317. (*                                                                      *)
  318. (*        Async_Init;                                                   *)
  319. (*                                                                      *)
  320. (*     Calls:  None                                                     *)
  321. (*                                                                      *)
  322. (*----------------------------------------------------------------------*)
  323.  
  324. BEGIN   (* Async_Init *)
  325.  
  326.   Async_DSeg_Save       := DSeg;
  327.   Async_Open_Flag       := FALSE;
  328.   Async_Buffer_Overflow := FALSE;
  329.   Async_Buffer_Used     := 0;
  330.   Async_MaxBufferUsed   := 0;
  331.   Async_XOFF_Sent       := FALSE;
  332.   Async_Buffer_Head     := 0;
  333.   Async_Buffer_Tail     := 0;
  334.  
  335. END     (* Async_Init *);
  336.  
  337. (*----------------------------------------------------------------------*)
  338. (*               Async_Close --- Close down communications interrupts   *)
  339. (*----------------------------------------------------------------------*)
  340.  
  341. PROCEDURE Async_Close;
  342.  
  343. (*----------------------------------------------------------------------*)
  344. (*                                                                      *)
  345. (*     Procedure:  Async_Close                                          *)
  346. (*                                                                      *)
  347. (*     Purpose:    Resets interrupt system when UART interrupts         *)
  348. (*                 are no longer needed.                                *)
  349. (*                                                                      *)
  350. (*     Calling Sequence:                                                *)
  351. (*                                                                      *)
  352. (*        Async_Close;                                                  *)
  353. (*                                                                      *)
  354. (*     Calls:  None                                                     *)
  355. (*                                                                      *)
  356. (*----------------------------------------------------------------------*)
  357.  
  358. VAR
  359.    i : INTEGER;
  360.    m : INTEGER;
  361.  
  362. BEGIN  (* Async_Close *)
  363.  
  364.    IF Async_Open_Flag THEN
  365.       BEGIN
  366.  
  367.                      (* disable the IRQ on the 8259 *)
  368.  
  369.          INLINE($FA);                 (* disable interrupts *)
  370.  
  371.          i := Port[I8088_IMR];        (* get the interrupt mask register *)
  372.          m := 1 SHL Async_Irq;        (* set mask to turn off interrupt  *)
  373.          Port[I8088_IMR] := i OR m;
  374.  
  375.                      (* disable the 8250 data ready interrupt *)
  376.  
  377.          Port[UART_IER + Async_Base] := 0;
  378.  
  379.                      (* disable OUT2 on the 8250 *)
  380.  
  381.          Port[UART_MCR + Async_Base] := 0;
  382.  
  383.          INLINE($FB);                 (* enable interrupts *)
  384.  
  385.                      (* re-initialize our data areas so we know *)
  386.                      (* the port is closed                      *)
  387.  
  388.          Async_Open_Flag := FALSE;
  389.          Async_XOFF_Sent := FALSE;
  390.  
  391.       END;
  392.  
  393. END    (* Async_Close *);
  394.  
  395. (*----------------------------------------------------------------------*)
  396. (*    Async_Clear_Errors --- Reset pending errors in async port         *)
  397. (*----------------------------------------------------------------------*)
  398.  
  399. PROCEDURE Async_Clear_Errors;
  400.  
  401. (*----------------------------------------------------------------------*)
  402. (*                                                                      *)
  403. (*     Procedure:   Async_Clear_Errors                                  *)
  404. (*                                                                      *)
  405. (*     Purpose:     Resets pending errors in async port                 *)
  406. (*                                                                      *)
  407. (*     Calling sequence:                                                *)
  408. (*                                                                      *)
  409. (*        Async_Clear_Errors;                                           *)
  410. (*                                                                      *)
  411. (*     Calls:  None                                                     *)
  412. (*                                                                      *)
  413. (*----------------------------------------------------------------------*)
  414.  
  415. VAR
  416.    I:  INTEGER;
  417.    M:  INTEGER;
  418.  
  419. BEGIN (* Async_Clear_Errors *)
  420.  
  421.                    (* Read the RBR and reset any pending error conditions. *)
  422.                    (* First turn off the Divisor Access Latch Bit to allow *)
  423.                    (* access to RBR, etc.                                  *)
  424.  
  425.    INLINE($FA);  (* disable interrupts *)
  426.  
  427.    Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] AND $7F;
  428.  
  429.                    (* Read the Line Status Register to reset any errors *)
  430.                    (* it indicates                                      *)
  431.  
  432.    I := Port[UART_LSR + Async_Base];
  433.  
  434.                    (* Read the Receiver Buffer Register in case it *)
  435.                    (* contains a character                         *)
  436.  
  437.    I := Port[UART_RBR + Async_Base];
  438.  
  439.                    (* enable the irq on the 8259 controller *)
  440.  
  441.    I := Port[I8088_IMR];  (* get the interrupt mask register *)
  442.    M := (1 SHL Async_Irq) XOR $00FF;
  443.  
  444.    Port[I8088_IMR] := I AND M;
  445.  
  446.                    (* enable the data ready interrupt on the 8250 *)
  447.  
  448.    Port[UART_IER + Async_Base] := $01;
  449.  
  450.                    (* enable OUT2 on 8250 *)
  451.  
  452.    I := Port[UART_MCR + Async_Base];
  453.    Port[UART_MCR + Async_Base] := I OR $08;
  454.  
  455.    INLINE($FB); (* enable interrupts *)
  456.  
  457. END   (* Async_Clear_Errors *);
  458.  
  459. (*----------------------------------------------------------------------*)
  460. (*    Async_Reset_Port --- Set/reset communications port parameters     *)
  461. (*----------------------------------------------------------------------*)
  462.  
  463. PROCEDURE Async_Reset_Port( ComPort       : INTEGER;
  464.                             BaudRate      : INTEGER;
  465.                             Parity        : CHAR;
  466.                             WordSize      : INTEGER;
  467.                             StopBits      : INTEGER  );
  468.  
  469. (*----------------------------------------------------------------------*)
  470. (*                                                                      *)
  471. (*     Procedure:   Async_Reset_Port                                    *)
  472. (*                                                                      *)
  473. (*     Purpose:     Resets communications port                          *)
  474. (*                                                                      *)
  475. (*     Calling Sequence:                                                *)
  476. (*                                                                      *)
  477. (*        Async_Reset_Port(   ComPort       : INTEGER;                  *)
  478. (*                            BaudRate      : INTEGER;                  *)
  479. (*                            Parity        : CHAR;                     *)
  480. (*                            WordSize      : INTEGER;                  *)
  481. (*                            StopBits      : INTEGER);                 *)
  482. (*                                                                      *)
  483. (*           ComPort  --- which port (1 or 2)                           *)
  484. (*           BaudRate --- Baud rate (110 to 9600)                       *)
  485. (*           Parity   --- "E" for even, "O" for odd, "N" for none       *)
  486. (*           WordSize --- Bits per character  (5 through 8)             *)
  487. (*           StopBits --- How many stop bits  (1 or 2)                  *)
  488. (*                                                                      *)
  489. (*     Calls:                                                           *)
  490. (*                                                                      *)
  491. (*        Async_Clear_Errors --- Clear async line errors                *)
  492. (*                                                                      *)
  493. (*----------------------------------------------------------------------*)
  494.  
  495. CONST   (* Baud Rate Constants *)
  496.  
  497.    Async_Num_Bauds = 8;
  498.  
  499.    Async_Baud_Table : ARRAY [1..Async_Num_Bauds] OF RECORD
  500.                                                        Baud, Bits : INTEGER;
  501.                                                     END
  502.  
  503.                     = ( ( Baud: 110;  Bits: $00 ),
  504.                         ( Baud: 150;  Bits: $20 ),
  505.                         ( Baud: 300;  Bits: $40 ),
  506.                         ( Baud: 600;  Bits: $60 ),
  507.                         ( Baud: 1200; Bits: $80 ),
  508.                         ( Baud: 2400; Bits: $A0 ),
  509.                         ( Baud: 4800; Bits: $C0 ),
  510.                         ( Baud: 9600; Bits: $E0 ) );
  511.  
  512. VAR
  513.    I       : INTEGER;
  514.    M       : INTEGER;
  515.    ComParm : INTEGER;
  516.  
  517. BEGIN (* Async_Reset_Port *)
  518.  
  519.             (*---------------------------------------------------*)
  520.             (*    Build the ComParm for RS232_Init               *)
  521.             (*    See Technical Reference Manual for description *)
  522.             (*---------------------------------------------------*)
  523.  
  524.                    (* Set up the bits for the baud rate *)
  525.  
  526.    IF BaudRate > 9600 THEN
  527.       BaudRate := 9600
  528.    ELSE IF BaudRate <= 0 THEN
  529.       BaudRate := 300;
  530.                                    (* Remember baud rate for purges *)
  531.    Async_Baud_Rate := BaudRate;
  532.  
  533.    I := 0;
  534.  
  535.    REPEAT
  536.       I := I + 1
  537.    UNTIL ( ( I >= Async_Num_Bauds ) OR
  538.            ( BaudRate = Async_Baud_Table[I].Baud ) );
  539.  
  540.    ComParm := Async_Baud_Table[I].Bits;
  541.  
  542.                    (* Choose Parity *)
  543.  
  544.    IF Parity In ['E', 'e'] THEN
  545.       ComParm := ComParm or $0018
  546.    ELSE IF Parity In ['O', 'o'] THEN
  547.       ComParm := ComParm or $0008;
  548.  
  549.                    (* Choose number of data bits *)
  550.  
  551.    WordSize := WordSize - 5;
  552.  
  553.    IF ( WordSize < 0 ) OR ( WordSize > 3 ) THEN
  554.       WordSize := 3;
  555.  
  556.    ComParm := ComParm OR WordSize;
  557.  
  558.                    (* Choose stop bits *)
  559.  
  560.    IF StopBits = 2 THEN
  561.       ComParm := ComParm OR $0004;  (* default is 1 stop bit *)
  562.  
  563.                    (* use the BIOS COM port initialization routine *)
  564.  
  565.    BIOS_RS232_Init( ComPort - 1 , ComParm );
  566.  
  567.                    (* Clear any pending errors on async line *)
  568.  
  569.    Async_Clear_Errors;
  570.  
  571. END   (* Async_Reset_Port *);
  572.  
  573. (*----------------------------------------------------------------------*)
  574. (*               Async_Open --- Open communications port                *)
  575. (*----------------------------------------------------------------------*)
  576.  
  577. FUNCTION Async_Open( ComPort       : INTEGER;
  578.                      BaudRate      : INTEGER;
  579.                      Parity        : CHAR;
  580.                      WordSize      : INTEGER;
  581.                      StopBits      : INTEGER  ) : BOOLEAN;
  582.  
  583. (*----------------------------------------------------------------------*)
  584. (*                                                                      *)
  585. (*     Function:   Async_Open                                           *)
  586. (*                                                                      *)
  587. (*     Purpose:    Opens communications port                            *)
  588. (*                                                                      *)
  589. (*     Calling Sequence:                                                *)
  590. (*                                                                      *)
  591. (*        Flag := Async_Open( ComPort       : INTEGER;                  *)
  592. (*                            BaudRate      : INTEGER;                  *)
  593. (*                            Parity        : CHAR;                     *)
  594. (*                            WordSize      : INTEGER;                  *)
  595. (*                            StopBits      : INTEGER) : BOOLEAN;       *)
  596. (*                                                                      *)
  597. (*           ComPort  --- which port (1 or 2)                           *)
  598. (*           BaudRate --- Baud rate (110 to 9600)                       *)
  599. (*           Parity   --- "E" for even, "O" for odd, "N" for none       *)
  600. (*           WordSize --- Bits per character  (5 through 8)             *)
  601. (*           StopBits --- How many stop bits  (1 or 2)                  *)
  602. (*                                                                      *)
  603. (*           Flag returned TRUE if port initialized successfully;       *)
  604. (*           Flag returned FALSE if any errors.                         *)
  605. (*                                                                      *)
  606. (*     Calls:                                                           *)
  607. (*                                                                      *)
  608. (*        Async_Reset_Port --- initialize RS232 port                    *)
  609. (*        DOS_Set_Intrpt   --- set address of RS232 interrupt routine   *)
  610. (*                                                                      *)
  611. (*----------------------------------------------------------------------*)
  612.  
  613. BEGIN  (* Async_Open *)
  614.                              (* IF port open, close it down first.  *)
  615.  
  616.    IF Async_Open_Flag THEN Async_Close;
  617.  
  618.                              (* Choose communications port *)
  619.    IF ComPort = 2 THEN
  620.       BEGIN
  621.          Async_Port := 2;
  622.          Async_Base := COM2_Base;
  623.          Async_Irq  := COM2_Irq;
  624.       END
  625.    ELSE
  626.       BEGIN
  627.          Async_Port := 1;  (* default to COM1 *)
  628.          Async_Base := COM1_Base;
  629.          Async_Irq  := COM1_Irq;
  630.       END;
  631.  
  632.    IF (Port[UART_IIR + Async_Base] and $00F8) <> 0 THEN
  633.       Async_Open := FALSE          (* Serial port not installed *)
  634.    ELSE
  635.       BEGIN   (* Open the port *)
  636.                                    (* Set up UART                   *)
  637.  
  638.          Async_Reset_Port( ComPort, BaudRate, Parity, WordSize, StopBits );
  639.  
  640.                                    (* Set interrupt routine address *)
  641.  
  642.          DOS_Set_Intrpt( Async_Irq + 8 , CSeg , Ofs( Async_Isr ) );
  643.  
  644.                                    (* Clear any pending errors *)
  645.          Async_Clear_Errors;
  646.  
  647.          Async_Open      := TRUE;
  648.          Async_Open_Flag := TRUE;
  649.  
  650.     END;
  651.  
  652. END   (* Async_Open *);
  653.  
  654. (*----------------------------------------------------------------------*)
  655. (*      Async_Carrier_Detect --- Check for modem carrier detect         *)
  656. (*----------------------------------------------------------------------*)
  657.  
  658. FUNCTION Async_Carrier_Detect : BOOLEAN;
  659.  
  660. (*----------------------------------------------------------------------*)
  661. (*                                                                      *)
  662. (*     Function:   Async_Carrier_Detect                                 *)
  663. (*                                                                      *)
  664. (*     Purpose:    Looks for modem carrier detect                       *)
  665. (*                                                                      *)
  666. (*     Calling Sequence:                                                *)
  667. (*                                                                      *)
  668. (*        Flag := Async_Carrier_Detect : BOOLEAN;                       *)
  669. (*                                                                      *)
  670. (*           Flag is set TRUE if carrier detected, else FALSE.          *)
  671. (*                                                                      *)
  672. (*     Calls:  None                                                     *)
  673. (*                                                                      *)
  674. (*----------------------------------------------------------------------*)
  675.  
  676. BEGIN (* Async_Carrier_Detect *)
  677.  
  678.    Async_Carrier_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 7 );
  679.  
  680. END   (* Async_Carrier_Detect *);
  681.  
  682. (*----------------------------------------------------------------------*)
  683. (*      Async_Carrier_Drop --- Check for modem carrier drop/timeout     *)
  684. (*----------------------------------------------------------------------*)
  685.  
  686. FUNCTION Async_Carrier_Drop : BOOLEAN;
  687.  
  688. (*----------------------------------------------------------------------*)
  689. (*                                                                      *)
  690. (*     Function:   Async_Carrier_Drop                                   *)
  691. (*                                                                      *)
  692. (*     Purpose:    Looks for modem carrier drop/timeout                 *)
  693. (*                                                                      *)
  694. (*     Calling Sequence:                                                *)
  695. (*                                                                      *)
  696. (*        Flag := Async_Carrier_Drop : BOOLEAN;                         *)
  697. (*                                                                      *)
  698. (*           Flag is set TRUE if carrier dropped, else FALSE.           *)
  699. (*                                                                      *)
  700. (*     Calls:  None                                                     *)
  701. (*                                                                      *)
  702. (*----------------------------------------------------------------------*)
  703.  
  704. BEGIN (* Async_Carrier_Drop *)
  705.  
  706.    Async_Carrier_Drop := NOT ODD( Port[ UART_MSR + Async_Base ] SHR 7 );
  707.  
  708. END   (* Async_Carrier_Drop *);
  709.  
  710. (*----------------------------------------------------------------------*)
  711. (*      Async_Term_Ready --- Set terminal ready status                  *)
  712. (*----------------------------------------------------------------------*)
  713.  
  714. PROCEDURE Async_Term_Ready( Ready_Status : BOOLEAN );
  715.  
  716. (*----------------------------------------------------------------------*)
  717. (*                                                                      *)
  718. (*     Procedure:  Async_Term_Ready                                     *)
  719. (*                                                                      *)
  720. (*     Purpose:    Sets terminal ready status                           *)
  721. (*                                                                      *)
  722. (*     Calling Sequence:                                                *)
  723. (*                                                                      *)
  724. (*        Async_Term_Ready( Ready_Status : BOOLEAN );                   *)
  725. (*                                                                      *)
  726. (*           Ready_Status --- Set TRUE to set terminal ready on,        *)
  727. (*                            Set FALSE to set terminal ready off.      *)
  728. (*                                                                      *)
  729. (*     Calls:  None                                                     *)
  730. (*                                                                      *)
  731. (*----------------------------------------------------------------------*)
  732.  
  733. VAR
  734.    Mcr_Value: BYTE;
  735.  
  736. BEGIN (* Async_Term_Ready *)
  737.  
  738.    Mcr_Value := Port[ UART_MCR + Async_Base ];
  739.  
  740.    IF ODD( Mcr_Value ) THEN Mcr_Value := Mcr_Value - 1;
  741.  
  742.    IF Ready_Status THEN Mcr_Value := Mcr_Value + 1;
  743.  
  744.    Port[ UART_MCR + Async_Base ] := Mcr_Value;
  745.  
  746. END   (* Async_Term_Ready *);
  747.  
  748. (*----------------------------------------------------------------------*)
  749. (*          Async_Buffer_Check --- Check if character in buffer         *)
  750. (*----------------------------------------------------------------------*)
  751.  
  752. FUNCTION Async_Buffer_Check : BOOLEAN;
  753.  
  754. (*----------------------------------------------------------------------*)
  755. (*                                                                      *)
  756. (*     Function:   Async_Buffer_Check                                   *)
  757. (*                                                                      *)
  758. (*     Purpose:    Check if character in buffer                         *)
  759. (*                                                                      *)
  760. (*     Calling Sequence:                                                *)
  761. (*                                                                      *)
  762. (*        Flag := Async_Buffer_Check : BOOLEAN;                         *)
  763. (*                                                                      *)
  764. (*           Flag returned TRUE if character received in buffer,        *)
  765. (*           Flag returned FALSE if no character received.              *)
  766. (*                                                                      *)
  767. (*     Calls:  None                                                     *)
  768. (*                                                                      *)
  769. (*     Remarks:                                                         *)
  770. (*                                                                      *)
  771. (*       This routine only checks if a character has been received      *)
  772. (*       and thus can be read; it does NOT return the character.        *)
  773. (*       Use Async_Receive to read the character.                       *)
  774. (*                                                                      *)
  775. (*----------------------------------------------------------------------*)
  776.  
  777. BEGIN   (* Async_Buffer_Check *)
  778.  
  779.    Async_Buffer_Check := ( Async_Buffer_Head <> Async_Buffer_Tail );
  780.  
  781. END     (* Async_Buffer_Check *);
  782.  
  783. (*----------------------------------------------------------------------*)
  784. (*          Async_Receive --- Return character from buffer              *)
  785. (*----------------------------------------------------------------------*)
  786.  
  787. FUNCTION Async_Receive( VAR C : Char ) : BOOLEAN;
  788.  
  789. (*----------------------------------------------------------------------*)
  790. (*                                                                      *)
  791. (*     Function:   Async_Receive                                        *)
  792. (*                                                                      *)
  793. (*     Purpose:    Retrieve character (if any) from buffer              *)
  794. (*                                                                      *)
  795. (*     Calling Sequence:                                                *)
  796. (*                                                                      *)
  797. (*        Flag := Async_Receive( VAR C: Char ) : BOOLEAN;               *)
  798. (*                                                                      *)
  799. (*           C --- character (if any) retrieved from buffer;            *)
  800. (*                 set to CHR(0) if no character available.             *)
  801. (*                                                                      *)
  802. (*           Flag returned TRUE if character retrieved from buffer,     *)
  803. (*           Flag returned FALSE if no character retrieved.             *)
  804. (*                                                                      *)
  805. (*     Calls:  None                                                     *)
  806. (*                                                                      *)
  807. (*----------------------------------------------------------------------*)
  808.  
  809. BEGIN   (* Async_Receive *)
  810.  
  811.    IF Async_Buffer_Head = Async_Buffer_Tail THEN
  812.       BEGIN (* No character to retrieve *)
  813.  
  814.          Async_Receive := FALSE;
  815.          C             := CHR( 0 );
  816.  
  817.       END   (* No character available   *)
  818.  
  819.    ELSE
  820.       BEGIN (* Character available *)
  821.  
  822.                    (* Turn off interrupts *)
  823.  
  824.          INLINE( $FA );       (* CLI --- Turn off interrupts *)
  825.  
  826.                    (* Get character from buffer *)
  827.  
  828.          C := Async_Buffer[ Async_Buffer_Tail ];
  829.  
  830.                    (* Increment buffer pointer.   IF past *)
  831.                    (* end of buffer, reset to beginning.  *)
  832.  
  833.          Async_Buffer_Tail := Async_Buffer_Tail + 1;
  834.  
  835.          IF Async_Buffer_Tail > Async_Buffer_Max THEN
  836.             Async_Buffer_Tail := 0;
  837.  
  838.                    (* Decrement buffer use count *)
  839.  
  840.          Async_Buffer_Used  := Async_Buffer_Used - 1;
  841.  
  842.                    (* Turn on interrupts *)
  843.  
  844.          INLINE( $FB );       (* STI --- Turn on interrupts *)
  845.  
  846.                    (* Indicate character successfully retrieved *)
  847.  
  848.          Async_Receive := TRUE;
  849.  
  850.       END   (* Character available *);
  851.  
  852. END   (* Async_Receive *);
  853.  
  854. (*----------------------------------------------------------------------*)
  855. (*   Async_Receive_With_TimeOut --- Return char. from buffer with delay *)
  856. (*----------------------------------------------------------------------*)
  857.  
  858. PROCEDURE Async_Receive_With_Timeout( Secs : INTEGER; VAR C : INTEGER );
  859.  
  860. (*----------------------------------------------------------------------*)
  861. (*                                                                      *)
  862. (*     Procedure:  Async_Receive_With_Timeout                           *)
  863. (*                                                                      *)
  864. (*     Purpose:    Retrieve character as integer from buffer,           *)
  865. (*                 or return TimeOut if specified delay period          *)
  866. (*                 expires.                                             *)
  867. (*                                                                      *)
  868. (*     Calling Sequence:                                                *)
  869. (*                                                                      *)
  870. (*        Async_Receive_With_Timeout( Secs: INTEGER; VAR C: INTEGER );  *)
  871. (*                                                                      *)
  872. (*           Secs ---  Timeout period in seconds                        *)
  873. (*           C     --- ORD(character) (if any) retrieved from buffer;   *)
  874. (*                     set to TimeOut if no character found before      *)
  875. (*                     delay period expires.                            *)
  876. (*                                                                      *)
  877. (*     Calls:  Async_Receive                                            *)
  878. (*             TimeOfDay                                                *)
  879. (*                                                                      *)
  880. (*     WATCH OUT!  THIS ROUTINE RETURNS AN INTEGER, NOT A CHARACTER!!!  *)
  881. (*                                                                      *)
  882. (*----------------------------------------------------------------------*)
  883.  
  884. VAR
  885.    Ch           : CHAR;
  886.    Time_Limit   : REAL;
  887.    B            : BOOLEAN;
  888.  
  889. BEGIN (* Async_Receive_With_Timeout *)
  890.  
  891.    IF Async_Buffer_Head <> Async_Buffer_Tail THEN
  892.       BEGIN
  893.          B := Async_Receive( Ch );
  894.          C := ORD( Ch );
  895.       END
  896.    ELSE
  897.       BEGIN
  898.                                    (* Convert time to milliseconds *)
  899.  
  900.          Time_Limit := Secs * 1000.0;
  901.  
  902.          WHILE ( Async_Buffer_Head = Async_Buffer_Tail ) AND
  903.                ( Time_Limit > 0.0 ) DO
  904.             BEGIN
  905.                Delay( 1 );
  906.                Time_Limit := Time_Limit - 1.0;
  907.             END;
  908.  
  909.          IF ( Async_Buffer_Head <> Async_Buffer_Tail ) AND
  910.             ( Time_Limit > 0.0 ) THEN
  911.             BEGIN
  912.                B := Async_Receive( Ch );
  913.                C := ORD( Ch );
  914.             END
  915.          ELSE
  916.             C := TimeOut;
  917.  
  918.       END;
  919.  
  920. END   (* Async_Receive_With_Timeout *);
  921.  
  922. (*----------------------------------------------------------------------*)
  923. (*            Async_Ring_Detect --- Check for phone ringing             *)
  924. (*----------------------------------------------------------------------*)
  925.  
  926. FUNCTION Async_Ring_Detect : BOOLEAN;
  927.  
  928. (*----------------------------------------------------------------------*)
  929. (*                                                                      *)
  930. (*     Function:   Async_Ring_Detect                                    *)
  931. (*                                                                      *)
  932. (*     Purpose:    Looks for phone ringing                              *)
  933. (*                                                                      *)
  934. (*     Calling Sequence:                                                *)
  935. (*                                                                      *)
  936. (*        Flag := Async_Ring_Detect : BOOLEAN;                          *)
  937. (*                                                                      *)
  938. (*           Flag is set TRUE if ringing detected, else FALSE.          *)
  939. (*                                                                      *)
  940. (*     Calls:  None                                                     *)
  941. (*                                                                      *)
  942. (*----------------------------------------------------------------------*)
  943.  
  944. BEGIN (* Async_Ring_Detect *)
  945.  
  946.    Async_Ring_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 6 );
  947.  
  948. END   (* Async_Ring_Detect *);
  949.  
  950. (*----------------------------------------------------------------------*)
  951. (*          Async_Send --- Send character over communications port      *)
  952. (*----------------------------------------------------------------------*)
  953.  
  954. PROCEDURE Async_Send( C : Char );
  955.  
  956. (*----------------------------------------------------------------------*)
  957. (*                                                                      *)
  958. (*     Procedure:  Async_Send                                           *)
  959. (*                                                                      *)
  960. (*     Purpose:    Sends character out over communications port         *)
  961. (*                                                                      *)
  962. (*     Calling Sequence:                                                *)
  963. (*                                                                      *)
  964. (*        Async_Send( C : Char );                                       *)
  965. (*                                                                      *)
  966. (*           C --- Character to send                                    *)
  967. (*                                                                      *)
  968. (*     Calls:  None                                                     *)
  969. (*                                                                      *)
  970. (*----------------------------------------------------------------------*)
  971.  
  972. VAR
  973.    i       : INTEGER;
  974.    m       : INTEGER;
  975.    Counter : INTEGER;
  976.  
  977. BEGIN   (* Async_Send *)
  978.  
  979.                    (* Turn on OUT2, DTR, and RTS *)
  980.  
  981.    Port[UART_MCR + Async_Base] := $0B;
  982.  
  983.                    (* Wait for CTS using Busy Wait *)
  984.  
  985.    Counter := MaxInt;
  986.  
  987.    WHILE ( Counter <> 0 ) AND
  988.          ( ( Port[UART_MSR + Async_Base] AND $10 ) = 0 ) DO
  989.       Counter := Counter - 1;
  990.  
  991.                    (* Wait for Transmit Hold Register Empty (THRE) *)
  992.  
  993.    IF Counter <> 0 THEN Counter := MaxInt;
  994.  
  995.    While ( Counter <> 0 ) AND
  996.          ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) Do
  997.       Counter := Counter - 1;
  998.  
  999.                    (* Send the character if port clear *)
  1000.  
  1001.   IF Counter <> 0 THEN
  1002.      BEGIN  (* Send the Character *)
  1003.  
  1004.         INLINE($FA); (* CLI --- disable interrupts *)
  1005.  
  1006.         Port[UART_THR + Async_Base] := Ord(C);
  1007.  
  1008.         INLINE($FB); (* STI --- enable interrupts *)
  1009.  
  1010.      END    (* Send the Character *)
  1011.  
  1012.   ELSE  (* Timed Out *)
  1013.      WRITELN('<<<TIMEOUT>>>');
  1014.  
  1015. END    (* Async_Send *);
  1016.  
  1017. (*----------------------------------------------------------------------*)
  1018. (*          Async_Send_Break --- Send break (attention) signal          *)
  1019. (*----------------------------------------------------------------------*)
  1020.  
  1021. PROCEDURE Async_Send_Break;
  1022.  
  1023. (*----------------------------------------------------------------------*)
  1024. (*                                                                      *)
  1025. (*     Procedure:  Async_Send_Break                                     *)
  1026. (*                                                                      *)
  1027. (*     Purpose:    Sends break signal over communications port          *)
  1028. (*                                                                      *)
  1029. (*     Calling Sequence:                                                *)
  1030. (*                                                                      *)
  1031. (*        Async_Send_Break;                                             *)
  1032. (*                                                                      *)
  1033. (*     Calls:  None                                                     *)
  1034. (*                                                                      *)
  1035. (*----------------------------------------------------------------------*)
  1036.  
  1037. VAR
  1038.    Old_Lcr   : BYTE;
  1039.    Break_Lcr : BYTE;
  1040.  
  1041. BEGIN (* Async_Send_Break *)
  1042.  
  1043.    Old_Lcr   := Port[ UART_LCR + Async_Base ];
  1044.    Break_Lcr := Old_Lcr;
  1045.  
  1046.    IF Break_Lcr >  127 THEN Break_Lcr := Break_Lcr - 128;
  1047.    IF Break_Lcr <=  63 THEN Break_Lcr := Break_Lcr +  64;
  1048.  
  1049.    Port[ UART_LCR + Async_Base ] := Break_Lcr;
  1050.  
  1051.    Delay( 400 );
  1052.  
  1053.    Port[ UART_LCR + Async_Base ] := Old_Lcr;
  1054.  
  1055. END   (* Async_Send_Break *);
  1056.  
  1057. (*----------------------------------------------------------------------*)
  1058. (*     Async_Send_String --- Send string over communications port       *)
  1059. (*----------------------------------------------------------------------*)
  1060.  
  1061. PROCEDURE Async_Send_String( S : AnyStr );
  1062.  
  1063. (*----------------------------------------------------------------------*)
  1064. (*                                                                      *)
  1065. (*     Procedure:  Async_Send_String                                    *)
  1066. (*                                                                      *)
  1067. (*     Purpose:    Sends string out over communications port            *)
  1068. (*                                                                      *)
  1069. (*     Calling Sequence:                                                *)
  1070. (*                                                                      *)
  1071. (*        Async_Send_String( S : AnyStr );                              *)
  1072. (*                                                                      *)
  1073. (*           S --- String to send                                       *)
  1074. (*                                                                      *)
  1075. (*     Calls:  Async_Send                                               *)
  1076. (*                                                                      *)
  1077. (*----------------------------------------------------------------------*)
  1078.  
  1079. VAR
  1080.    i : INTEGER;
  1081.  
  1082. BEGIN  (* Async_Send_String *)
  1083.  
  1084.   FOR i := 1 TO LENGTH( S ) DO
  1085.      Async_Send( S[i] )
  1086.  
  1087. END    (* Async_Send_String *);
  1088.  
  1089. (*----------------------------------------------------------------------*)
  1090. (*     Async_Send_String_With_Delays --- Send string with timed delays  *)
  1091. (*----------------------------------------------------------------------*)
  1092.  
  1093. PROCEDURE Async_Send_String_With_Delays( S          : AnyStr;
  1094.                                          Char_Delay : INTEGER;
  1095.                                          EOS_Delay  : INTEGER  );
  1096.  
  1097. (*----------------------------------------------------------------------*)
  1098. (*                                                                      *)
  1099. (*     Procedure:  Async_Send_String_With_Delays                        *)
  1100. (*                                                                      *)
  1101. (*     Purpose:    Sends string out over communications port with       *)
  1102. (*                 specified delays for each character and at the       *)
  1103. (*                 end of the string.                                   *)
  1104. (*                                                                      *)
  1105. (*     Calling Sequence:                                                *)
  1106. (*                                                                      *)
  1107. (*        Async_Send_String_With_Delays( S          : AnyStr ;          *)
  1108. (*                                       Char_Delay : INTEGER;          *)
  1109. (*                                       EOS_Delay  : INTEGER );        *)
  1110. (*                                                                      *)
  1111. (*           S          --- String to send                              *)
  1112. (*           Char_Delay --- Number of milliseconds to delay after       *)
  1113. (*                          sending each character                      *)
  1114. (*           EOS_Delay  --- Number of milleseconds to delay after       *)
  1115. (*                          sending last character in string            *)
  1116. (*                                                                      *)
  1117. (*     Calls:  Async_Send                                               *)
  1118. (*             Async_Send_String                                        *)
  1119. (*             Length                                                   *)
  1120. (*             Delay                                                    *)
  1121. (*                                                                      *)
  1122. (*     Remarks:                                                         *)
  1123. (*                                                                      *)
  1124. (*        This routine is useful when writing routines to perform       *)
  1125. (*        non-protocol uploads.  Many computer systems require delays   *)
  1126. (*        between receipt of characters for correct processing.  The    *)
  1127. (*        delay for end-of-string usually applies when the string       *)
  1128. (*        represents an entire line of a file.                          *)
  1129. (*                                                                      *)
  1130. (*        If delays are not required, Async_Send_String is faster.      *)
  1131. (*        This routine will call Async_Send_String is no character      *)
  1132. (*        delay is to be done.                                          *)
  1133. (*                                                                      *)
  1134. (*----------------------------------------------------------------------*)
  1135.  
  1136. VAR
  1137.    I : INTEGER;
  1138.  
  1139. BEGIN  (* Async_Send_String_With_Delays *)
  1140.  
  1141.    IF Char_Delay <= 0 THEN
  1142.       Async_Send_String( S )
  1143.    ELSE
  1144.       FOR I := 1 TO LENGTH( S ) DO
  1145.          BEGIN
  1146.             Async_Send( S[I] );
  1147.             Delay( Char_Delay );
  1148.          END;
  1149.  
  1150.    IF EOS_Delay > 0 THEN Delay( EOS_Delay );
  1151.  
  1152. END    (* Async_Send_String_With_Delays *);
  1153.  
  1154. (*----------------------------------------------------------------------*)
  1155. (*      Async_Percentage_Used --- Report Percentage Buffer Filled       *)
  1156. (*----------------------------------------------------------------------*)
  1157.  
  1158. FUNCTION Async_Percentage_Used : REAL;
  1159.  
  1160. (*----------------------------------------------------------------------*)
  1161. (*                                                                      *)
  1162. (*     Function:   Async_Percent_Used                                   *)
  1163. (*                                                                      *)
  1164. (*     Purpose:    Reports percentage of com buffer currently filled    *)
  1165. (*                                                                      *)
  1166. (*     Calling Sequence:                                                *)
  1167. (*                                                                      *)
  1168. (*        Percentage := Async_Percentage_Used : Real;                   *)
  1169. (*                                                                      *)
  1170. (*           Percentage gets how much of buffer is filled;              *)
  1171. (*           value goes from 0.0 (empty) to 1.0 (totally full).         *)
  1172. (*                                                                      *)
  1173. (*     Calls:  None                                                     *)
  1174. (*                                                                      *)
  1175. (*     Remarks:                                                         *)
  1176. (*                                                                      *)
  1177. (*       This routine is helpful when incorporating handshaking into    *)
  1178. (*       a communications program.  For example, assume that the host   *)
  1179. (*       computer uses the XON/XOFF (DC1/DC3) protocol.  Then the       *)
  1180. (*       PC program should issue an XOFF  to the host when the value    *)
  1181. (*       returned by Async_Percentage_Used > .75 or so.  When the       *)
  1182. (*       utilization percentage drops below .25 or so, the PC program   *)
  1183. (*       should transmit an XON.                                        *)
  1184. (*                                                                      *)
  1185. (*----------------------------------------------------------------------*)
  1186.  
  1187. BEGIN (* Async_Percentage_Used *)
  1188.  
  1189.    Async_Percentage_Used := Async_Buffer_Used / ( Async_Buffer_Max + 1 );
  1190.  
  1191. END   (* Async_Percentage_Used *);
  1192.  
  1193. (*----------------------------------------------------------------------*)
  1194. (*     Async_Purge_Buffer --- Purge communications input buffer         *)
  1195. (*----------------------------------------------------------------------*)
  1196.  
  1197. PROCEDURE Async_Purge_Buffer;
  1198.  
  1199. (*----------------------------------------------------------------------*)
  1200. (*                                                                      *)
  1201. (*     Procedure:  Async_Purge_Buffer                                   *)
  1202. (*                                                                      *)
  1203. (*     Purpose:    Purges communications input buffer                   *)
  1204. (*                                                                      *)
  1205. (*     Calling Sequence:                                                *)
  1206. (*                                                                      *)
  1207. (*        Async_Purge_Buffer;                                           *)
  1208. (*                                                                      *)
  1209. (*     Calls:  Async_Receive                                            *)
  1210. (*                                                                      *)
  1211. (*----------------------------------------------------------------------*)
  1212.  
  1213. VAR
  1214.    C: CHAR;
  1215.    L: INTEGER;
  1216.  
  1217. BEGIN  (* Async_Purge_Buffer *)
  1218.  
  1219.    L     := 10000 DIV Async_Baud_Rate;
  1220.  
  1221.    REPEAT
  1222.       Delay( L );
  1223.    UNTIL ( NOT Async_Receive( C ) );
  1224.  
  1225. END    (* Async_Purge_Buffer *);
  1226.  
  1227. (*----------------------------------------------------------------------*)
  1228. (*          Async_Buffer_Full --- Check if com buffer nearly full       *)
  1229. (*----------------------------------------------------------------------*)
  1230.  
  1231. PROCEDURE Async_Buffer_Full;
  1232.  
  1233. (*----------------------------------------------------------------------*)
  1234. (*                                                                      *)
  1235. (*     Procedure:  Async_Buffer_Full                                    *)
  1236. (*                                                                      *)
  1237. (*     Purpose:    Check if buffer nearly full, issue XOFF if so.       *)
  1238. (*                                                                      *)
  1239. (*     Calling Sequence:                                                *)
  1240. (*                                                                      *)
  1241. (*        Async_Buffer_Full;                                            *)
  1242. (*                                                                      *)
  1243. (*     Calls:  Async_Send                                               *)
  1244. (*                                                                      *)
  1245. (*     Remarks:                                                         *)
  1246. (*                                                                      *)
  1247. (*         An XOFF if issued if the buffer is nearly full and an XOFF   *)
  1248. (*         has not been previously issued.  If an XOFF was previously   *)
  1249. (*         issued, and the buffer is reasonably empty,  then an XON     *)
  1250. (*         is issued.                                                   *)
  1251. (*                                                                      *)
  1252. (*----------------------------------------------------------------------*)
  1253.  
  1254. BEGIN   (* Async_Buffer_Full *)
  1255.  
  1256.    IF ( Async_Buffer_Used * 4 ) > ( Async_Buffer_Max * 3 ) THEN
  1257.       BEGIN  (* Buffer too full -- send XOFF if we already haven't *)
  1258.          IF ( NOT Async_XOFF_Sent ) THEN
  1259.             BEGIN
  1260.                Async_Send( Async_XOFF );
  1261.                Async_XOFF_Sent := TRUE;
  1262.             END
  1263.       END    (* Buffer too full *)
  1264.    ELSE IF ( Async_Buffer_Used * 4 ) < Async_Buffer_Max THEN
  1265.       BEGIN  (* Buffer reasonably empty -- send XON if needed *)
  1266.          IF Async_XOFF_Sent THEN
  1267.             BEGIN
  1268.                Async_Send( Async_XON );
  1269.                Async_XOFF_Sent := FALSE;
  1270.             END;
  1271.       END;
  1272.  
  1273. END     (* Async_Buffer_Full *);
  1274.